home *** CD-ROM | disk | FTP | other *** search
/ Win 50 Game+ Vol. 7 (Japan) / Win 50 Game+ Vol. 7 (Japan).7z / Win 50 Game+ Vol. 7 (Japan).bin / lha_file / dpgolf11.lzh / DPG11SRC.LZH / ABOUT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-21  |  5KB  |  171 lines
  1. unit About;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
  6.   Buttons, Spin, ExtCtrls;
  7.  
  8. type
  9.   TAboutBox = class(TForm)
  10.     Panel1: TPanel;
  11.     Comment: TLabel;
  12.     ProductName: TLabel;
  13.     Version: TLabel;
  14.     Okbutton: TButton;
  15.     Cancelbtn: TButton;
  16.     Combo1: TComboBox;
  17.     Makebtn: TButton;
  18.     Spin1: TSpinEdit;
  19.     Spin2: TSpinEdit;
  20.     Spin3: TSpinEdit;
  21.     Spin4: TSpinEdit;
  22.     Spin5: TSpinEdit;
  23.     Label1: TLabel;
  24.     Label2: TLabel;
  25.     Label3: TLabel;
  26.     Label4: TLabel;
  27.     Label5: TLabel;
  28.     procedure MakebtnClick(Sender: TObject);
  29.     procedure Combo1Change(Sender: TObject);
  30.     procedure FormCreate(Sender: TObject);
  31.   private
  32.     { Private ÉΘî╛ }
  33.     procedure setspin(a,b,c,d,e : integer);
  34.   public
  35.     { Public ÉΘî╛ }
  36.   end;
  37.  
  38. var
  39.   AboutBox: TAboutBox;
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. var map : array[0..15,0..15] of byte;
  46.     hgt, dx, dy : array[-1..16,-1..16] of real;
  47.     data : file of byte;
  48.  
  49. procedure TAboutBox.MakebtnClick(Sender: TObject);
  50. var i, j, k, l, m, n, x, y, xx, yy, w, wx, wy, f : integer;
  51.     r : real;
  52.     bt : byte;
  53. begin
  54.     randomize;
  55.     screen.cursor := crHourGlass;
  56.     assignfile(data,'dpgolf.dat');
  57.     rewrite(data);
  58.     comment.caption := 'Now making course...';
  59.     comment.update;
  60.     for l := 1 to 18 do begin
  61.         if spin5.value = 0
  62.             then r := (5 + random(25))/40
  63.             else r := (4 + spin5.value + random(15+ spin5.value))/40;
  64.         for i := 0 to 15 do for j := 0 to 15 do map[j,i] := 0;
  65.         for i := 6 to 8 do for j := 6 to 8 do map[j,i] := 1;
  66.         f := 9;
  67.         repeat
  68.             repeat
  69.                 x := random(13);
  70.                 y := random(13);
  71.                 k := 0;
  72.                 for i := 0 to 3 do for j := 0 to 3 do inc(k,map[x+j,y+i]);
  73.             until (k >= 4) and (k <= 15);
  74.             f := f + 16 - k;
  75.             for i := 0 to 3 do for j := 0 to 3 do map[x+j,y+i] := 1;
  76.         until f >= round(16 * 16 * r);
  77.         for i := -1 to 16 do for j := -1 to 16 do begin
  78.             hgt[j,i] := 0.0;
  79.             dx[j,i] := 0.0;
  80.             dy[j,i] := 0.0;
  81.         end;
  82.         m := random(spin1.value - 2) + 2;
  83.         for k := 1 to spin3.value do begin
  84.             w := random(spin1.value - m + 1) + m;
  85.             wx := random(w-1) + 1;
  86.             wy := w - wx;
  87.             if random > 0.5 then f := 1 else f := -1;
  88.             repeat
  89.                 x := random(16);
  90.                 y := random(16);
  91.             until map[x,y] = 1;
  92.             n := 20 - random(spin2.value);
  93.             for i := -1 to 16 do for j := -1 to 16 do begin
  94.                 xx := abs(x - j);
  95.                 yy := abs(y - i);
  96.                 if (xx <= wx) and (yy <= wy) then hgt[j,i] := hgt[j,i] +
  97.                     ((1 - xx / wx) * (1 - yy / wy)) * n * f;
  98.             end;
  99.         end;
  100.         for i := 0 to 15 do for j := 0 to 15 do begin
  101.             dx[j,i] := hgt[j+1,i] + hgt[j+1,i-1] + hgt[j+1,i+1]
  102.                      - hgt[j-1,i] - hgt[j-1,i-1] - hgt[j-1,i+1];
  103.             dy[j,i] := hgt[j,i+1] + hgt[j-1,i+1] + hgt[j+1,i+1]
  104.                      - hgt[j,i-1] - hgt[j-1,i-1] - hgt[j+1,i-1];
  105.         end;
  106.         r := 0.0;
  107.         for i := 0 to 15 do for j := 0 to 15 do begin
  108.             if abs(dx[j,i]) > r then r := abs(dx[j,i]);
  109.             if abs(dy[j,i]) > r then r := abs(dy[j,i]);
  110.         end;
  111.         r := spin4.value / r;
  112.         for i := 0 to 15 do for j := 0 to 15 do begin
  113.             dx[j,i] := dx[j,i] * r;
  114.             dy[j,i] := dy[j,i] * r;
  115.             if (trunc(dx[j,i]) = 0) and (trunc(dy[j,i]) = 0) then
  116.                 if abs(dx[j,i]) >= abs(dy[j,i]) then begin
  117.                     dy[j,i] := dy[j,i] / (abs(dx[j,i]) + 0.01) * 1.9;
  118.                     dx[j,i] := 1.1;
  119.                 end else begin
  120.                     dx[j,i] := dx[j,i] / (abs(dy[j,i]) + 0.01) * 1.9;
  121.                     dy[j,i] := 1.1;
  122.                 end;
  123.         end;
  124.         for m := 0 to 15 do for n := 0 to 15 do begin
  125.             if map[n,m] = 0 then bt := $88
  126.                 else bt := (trunc(dy[n,m] + 8)) * 16 + trunc(dx[n,m] + 8);
  127.             write(data,bt);
  128.         end;
  129.         repeat
  130.             repeat m := random(256) until map[m mod 16,m div 16] = 1;
  131.             repeat n := random(256) until map[n mod 16,n div 16] = 1;
  132.         until ((m mod 16) - (n mod 16))*((m mod 16) - (n mod 16)) +
  133.               ((m div 16) - (n div 16))*((m div 16) - (n div 16))
  134.                 >= 20 + random(spin5.value)*2;
  135.         n := 255 - n;
  136.         write(data,byte(m),byte(n));
  137.     end;
  138.     closefile(data);
  139.     screen.cursor := crDefault;
  140. end;
  141.  
  142. procedure TAboutBox.setspin(a,b,c,d,e : integer);
  143. begin
  144.     spin1.value := a;
  145.     spin2.value := b;
  146.     spin3.value := c;
  147.     spin4.value := d;
  148.     spin5.value := e;
  149. end;
  150.  
  151. procedure TAboutBox.Combo1Change(Sender: TObject);
  152. begin
  153.     case combo1.itemindex of
  154.         0 : setspin(10, 5,20,4,4);
  155.         1 : setspin(10,10, 5,3,3);
  156.         2 : setspin(15, 2,30,5,5);
  157.         3 : setspin(10,15, 3,2,1);
  158.         4 : setspin(15, 1,30,7,6);
  159.         5 : setspin(20, 5, 1,5,4);
  160.         6 : setspin(random(16)+5,random(10)+1,random(36)+5,random(6)+2,0);
  161.     end;
  162. end;
  163.  
  164. procedure TAboutBox.FormCreate(Sender: TObject);
  165. begin
  166.     combo1.itemindex := 0;
  167. end;
  168.  
  169. end.
  170.  
  171.